home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue45 / Alfresco / Project1.dpr < prev   
Encoding:
Text File  |  2000-11-02  |  3.5 KB  |  165 lines
  1. program Project1;
  2.  
  3. {$IFDEF WIN32}
  4. {$APPTYPE CONSOLE}
  5. {$ENDIF}
  6.  
  7. uses
  8.   {$IFDEF Windows}
  9.   WinCrt,
  10.   {$ENDIF}
  11.   SysUtils,
  12.   Classes,
  13.   AALZHash in 'AALZHash.pas',
  14.   AALZSWin in 'AALZSWin.PAS',
  15.   AALZCmpr in 'AALZCmpr.pas',
  16.   AABufStm in 'AABufStm.PAS';
  17.  
  18. {$IFDEF Windows}
  19. function CompareMem(const Buf1, Buf2 : pointer; Count: Word): Boolean; assembler;
  20. asm
  21.         PUSH    DS
  22.         LDS     SI,Buf1
  23.         LES     DI,Buf2
  24.         MOV     CX,Count
  25.         XOR     AX,AX
  26.         CLD
  27.         REPE    CMPSB
  28.         JNE     @@1
  29.         INC     AX
  30. @@1:    POP     DS
  31. end;
  32. {$ENDIF}
  33.  
  34. function CompareStreams(aStream1, aStream2 : TStream) : boolean;
  35. var
  36.   Buf1, Buf2 : PByteArray;
  37.   BytesRead : integer;
  38. begin
  39.   Result := false;
  40.   if (aStream1.Size <> aStream2.Size) then
  41.     Exit;
  42.   aStream1.Position := 0;
  43.   aStream2.Position := 0;
  44.  
  45.   GetMem(Buf1, 8192);
  46.   try
  47.    GetMem(Buf2, 8192);
  48.    try
  49.      BytesRead := aStream1.Read(Buf1^, 8192);
  50.      aStream2.Read(Buf2^, 8192);
  51.      if not CompareMem(Buf1, Buf2, BytesRead) then
  52.        Exit;
  53.    finally
  54.      FreeMem(Buf2, 8192);
  55.    end;
  56.   finally
  57.     FreeMem(Buf1, 8192);
  58.   end;
  59.   Result := true;
  60. end;
  61.  
  62. procedure PackUnpack(const aFileName : string);
  63. var
  64.   InStrm : TFileStream;
  65.   OutStrm : TFileStream;
  66.   InBufStm, OutBufStm : TaaBufferedStream;
  67.   Equal : boolean;
  68.   OrigSize : longint;
  69.   Ratio : double;
  70. begin
  71.   write('Processing ', aFileName);
  72.  
  73.   InStrm := TFileStream.Create(aFileName, fmOpenRead OR fmShareDenyNone);
  74.   try
  75.     OutStrm := TFileStream.Create('c:\LLL.LZA', fmCreate OR fmOpenReadWrite);
  76.     try
  77.       InBufStm := TaaBufferedStream.Create(InStrm, 8192);
  78.       try
  79.         OutBufStm := TaaBufferedStream.Create(OutStrm, 8192);
  80.         try
  81.           OrigSize := InStrm.Size;
  82.           AALZCompress(InBufStm, OutBufStm);
  83.         finally
  84.           OutBufStm.Free;
  85.         end;
  86.       finally
  87.         InBufStm.Free;
  88.       end;
  89.     finally
  90.       OutStrm.Free
  91.     end;
  92.   finally
  93.     InStrm.Free
  94.   end;
  95.  
  96.   InStrm := TFileStream.Create('c:\LLL.LZA', fmOpenRead);
  97.   try
  98.     OutStrm := TFileStream.Create('c:\LLL.OUT', fmCreate OR fmOpenReadWrite);
  99.     try
  100.       InBufStm := TaaBufferedStream.Create(InStrm, 8192);
  101.       try
  102.         OutBufStm := TaaBufferedStream.Create(OutStrm, 8192);
  103.         try
  104.           if OrigSize = 0 then
  105.             Ratio := -1
  106.           else
  107.             Ratio := (InStrm.Size * 100.0) / OrigSize;
  108.           AALZDecompress(InBufStm, OutBufStm);
  109.         finally
  110.           OutBufStm.Free;
  111.         end;
  112.       finally
  113.         InBufStm.Free;
  114.       end;
  115.     finally
  116.       OutStrm.Free
  117.     end;
  118.   finally
  119.     InStrm.Free
  120.   end;
  121.  
  122.   InStrm := TFileStream.Create(aFileName, fmOpenRead OR fmShareDenyNone);
  123.   try
  124.     OutStrm := TFileStream.Create('c:\LLL.OUT', fmOpenRead);
  125.     try
  126.       Equal := CompareStreams(InStrm, OutStrm);
  127.     finally
  128.       OutStrm.Free
  129.     end;
  130.   finally
  131.     InStrm.Free
  132.   end;
  133.  
  134.   if Equal then
  135.     writeln('  Passed ', Ratio:5:1, '%')
  136.   else begin
  137.     writeln('  Failed');
  138.     readln;
  139.   end;
  140.  
  141. end;
  142.  
  143. var
  144.   Dir : string;
  145.   SR  : TSearchRec;
  146.   Res : integer;
  147. begin
  148.   if (ParamCount = 1) then
  149.     Dir := ParamStr(1)
  150.   else
  151.     Dir := ExtractFilePath(ParamStr(0));
  152.   if (Dir[length(Dir)] <> '\') then
  153.     Dir := Dir + '\';
  154.   Res := FindFirst(Dir + '*.*', faAnyfile, SR);
  155.   while  Res = 0 do begin
  156.     if ((SR.Attr and faDirectory) = 0) then
  157.       PackUnpack(Dir + SR.Name);
  158.     Res := FindNext(SR);
  159.   end;
  160.   FindClose(SR);
  161.  
  162.   writeln('All done');
  163.   readln;
  164. end.
  165.